unit ExpRest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, FMTBcd, DB, SqlExpr;

type
  TExp = class(TDataModule)
    OldExp: TSQLDataSet;
    NewExp: TSQLDataSet;
  private
    { Private declarations }
    function Tbl(DBType: Byte): TDataSet;
    function ExpName(DBType : Byte) : String;
    function ValueEqual(FName : String) : Boolean;
    function GetValue(FName : String; IsChar : Boolean) : String;

    procedure CreateException;
    procedure AlterException;
  public
    { Public declarations }
    procedure CheckException;
  end;

var
  Exp: TExp;

procedure CheckExceptions(ProgBar : TProgressBar);

implementation

uses Data, ReportForm, DomainRest;

{$R *.DFM}

procedure CheckExceptions;
begin
  ProgBar.Position:=0;
  // how many domains are there ?
  Exp.NewExp.CommandText:=
    'select count(*) as ccc from RDB$EXCEPTIONS';
  Exp.NewExp.Open;
  ProgBar.Max:=Exp.NewExp.fieldByName('ccc').AsInteger;
  Exp.NewExp.Close;

  Exp.NewExp.CommandText:=
    'select * from RDB$EXCEPTIONS';

  Exp.NewExp.Open;
  Exp.OldExp.Open;

  Exp.NewExp.First;
  While not Exp.NewExp.Eof do
  begin
    Application.ProcessMessages;
    ProgBar.Position:=ProgBar.Position+1;
    Exp.CheckException;
    Exp.NewExp.Next;
  end;
  Exp.OldExp.Close;
  Exp.NewExp.Close;
end;

{ TDmn }

function TExp.Tbl(DBType: Byte): TDataSet;
begin
  case DBType of
    fcNew : Result:=NewExp;
    fcOld : Result:=OldExp;
  end;
end;

function TExp.ExpName(DBType: Byte): String;
begin
  Result:=Trim(Tbl(DBType).FieldByName('RDB$EXCEPTION_NAME').AsString);
end;

function TExp.GetValue(FName : String; IsChar: Boolean): String;
begin
  Result:=NewExp.FieldByName(FName).AsString;
  if Result='' then
    Result:='NULL'
  else
    if IsChar then Result:=#39+Result+#39;
end;

function TExp.ValueEqual(FName: String): Boolean;
begin
  Result:=Tbl(fcNew).FieldByName(FName).AsString=Tbl(fcOld).FieldByName(FName).AsString;
end;

procedure TExp.CreateException;
begin
  DM.SQL.Clear;
  if DM.Dialect=1 then
    DM.SQL.Add('CREATE EXCEPTION '+ExpName(fcNew)+' '+GetValue('RDB$MESSAGE',True))
  else
    DM.SQL.Add('CREATE EXCEPTION "'+ExpName(fcNew)+'" '+GetValue('RDB$MESSAGE',True));

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('EXCEPTION',Trim(ExpName(fcNew)),'not exist');
    except
      if DM.ShowReport then Rep.AddToReport('EXCEPTION',Trim(ExpName(fcNew)),'error');
    end;
  end else
  begin
    DM.AddToStrings('EXCEPTION '+Trim(ExpName(fcNew)),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('EXCEPTION',Trim(ExpName(fcNew)),'not exist');
  end;
end;

procedure TExp.AlterException;
begin
  DM.SQL.Clear;
  DM.SQL.Add('ALTER EXCEPTION "'+ExpName(fcNew)+'" '+GetValue('RDB$MESSAGE',True));

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('EXCEPTION',Trim(ExpName(fcNew)),'different type');
    except
      if DM.ShowReport then Rep.AddToReport('EXCEPTION',Trim(ExpName(fcNew)),'error');
    end;
  end else
  begin
    DM.AddToStrings('EXCEPTION '+Trim(ExpName(fcNew)),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('EXCEPTION',Trim(ExpName(fcNew)),'different type');
  end;
end;

procedure TExp.CheckException;
begin
  OldExp.Close;
  OldExp.ParamByName('EName').AsString:=ExpName(fcNew);
  OldExp.Open;
  if ExpName(fcOld)=ExpName(fcNew) then
  begin
    if not ValueEqual('RDB$MESSAGE') then
      AlterException;
  end else CreateException;
end;

end.
